Metadata from IPBES on Zenodo

Technical Guideline Series

Abstract

To be added

GitHub Repository

Methods

Setup and get records from Zenodo

#|

# Load the zen4R library
library(zen4R)
library(openalexR)

Thank you for using openalexR!
To acknowledge our work, please cite the package by calling `citation("openalexR")`.
To suppress this message, add `openalexR.message = suppressed` to your .Renviron file.

library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

fn <- file.path("data", "ipbes_zenodo_records")
if (!file.exists(paste0(fn, ".rds"))) {
  # Authenticate with Zenodo
  zen <- ZenodoManager$new(token = Sys.getenv("Zenodo_IPBES_RO"))

  # Get the community ID
  community_id <- "ipbes"

  # Get the community info
  community <- zen$getCommunityById(community_id)

  # Get all deposits with ipbes somwhere
  ipbes_zenodo <- zen$getRecords(community_id)

  # Filter records based on the community ID
  ipbes <- sapply(
    ipbes_zenodo,
    function(record) {
      "ipbes" %in% unlist(record$metadata$communities)
    }
  )

  ipbes_zenodo <- ipbes_zenodo[ipbes]

  rm(ipbes)

  saveRDS(ipbes_zenodo, paste0(fn, ".rds"))
} else {
  ipbes_zenodo <- readRDS(paste0(fn, ".rds"))
}

Get the dois and titles of the records

dois <- data.frame()

for (i in seq(length.out = length(ipbes_zenodo))) {
  record <- ipbes_zenodo[[i]]
  dois <- rbind(
    dois,
    c(
      doi = record$metadata$doi,
      year = record$metadata$publication_date,
      title = record$metadata$title
    )
  )
}

names(dois) <- c("doi", "year", "title")

dois <- tibble::as_tibble(dois)

#|
fn <- file.path(".", "data", "ipbes_works.rds")
if (!file.exists(fn)) {
  # Define the maximum chunk size
  chunk_size <- 50
  # Split the vector into chunks
  doi_chunks <- split(
    dois$doi,
    ceiling(seq_along(dois$doi) / chunk_size)
  )

  ipbes_works <- lapply(
    doi_chunks,
    function(dois) {
      openalexR::oa_query(doi = dois) |>
        openalexR::oa_request(count_only = FALSE)
    }
  ) |>
    unlist(recursive = FALSE)

  saveRDS(ipbes_works, file = fn)
} else {
  ipbes_works <- readRDS(file = fn)
}

Results

Keywords

Number of keywords per Deposit

ipbes_zenodo |>
  sapply(
    FUN = function(x) {
      x$metadata$keywords |>
        unlist() |>
        length()
    }
  ) |>
  table() |>
  knitr::kable(
    col.names = c("Number of keywords", "n")
  )

Number of keywords	n
0	129
1	61
2	44
3	77
4	21
5	10
6	13
7	8
8	1
9	1
10	1

Keywords used in the deposits

ipbes_zenodo |>
  sapply(
    FUN = function(x) {
      x$metadata$keywords |>
        unlist()
    }
  ) |>
  unlist() |>
  table() |>
  sort(decreasing = TRUE) |>
  knitr::kable(col.names = c("Keyword", "n"))

Keyword	n
IPBES	178
Data management report	47
Assessment	36
data management policy	31
Values Assessment	30
Invasive alien species	27
Global Assessment	20
Supplementary material	19
Europe and Central Asia Assessment	18
Chapter 4	15
Summary for Policymakers	14
Table	13
Chapter 2	12
Figure	11
SPM	11
Full assessment report	9
Values	9
Chapter	8
Chapter 3	8
Chapter 6	7
Chapter 5	6
Regional assessment	6
Africa Assessment	5
Decision	4
Summary for policymakers	4
Biodiversity	3
Chapter 1	3
data and knowledge management policy	3
data management	3
Future	3
ILK	3
Land Degradation and Restoration Assessment	3
Pollination Assessment	3
Scenarios and Models Assessment	3
Valuation	3
Americas Assessment	2
Arabic	2
Asia and the Pacific Assessment	2
Capacities	2
Chinese	2
Data Management	2
Decision-making	2
Diverse	2
FAIR	2
French	2
Just	2
Methods	2
Operationalization	2
Russian	2
Spanish	2
stakeholder engagement	2
survey	2
Sustainable	2
active data management	1
Anthrome	1
Approaches	1
Archetypes	1
Biocultural conservation	1
Biome	1
Brightspot cases	1
CARE	1
CARE principles	1
Climate change	1
Climate Change	1
Conceptualization	1
Constitutions	1
COVID-19	1
Data and knowledge management policy	1
data backup	1
Data Management Policy	1
Data Management Report, Nature Futures Framework	1
Data Policy	1
Dataset	1
Decision making	1
Diverse values	1
DOI	1
Earth Stewardship	1
FAIR principles	1
Gap	1
global, species rarity, endemicity	1
Indicators	1
Indigenous Peoples and local communities	1
IPBES, Data Management Policy	1
IPBES, Senckenberg, Data Management, Policy, FAIR	1
IPBES, Values, Assessment, Figures, Chapter 1	1
IPBES, Values, SPM, Values	1
IPCC	1
IPCCC	1
Knowledge Management	1
long-term vision	1
Methodological	1
Methodological guidance	1
Methodologies	1
Model	1
Nature	1
Nature Futures Framework	1
open science	1
Option	1
Pandemics	1
Pathway	1
Plural Value Approach	1
Policy	1
Policy initiatives	1
Policy instruments	1
Pollination assessment	1
Scenario	1
scenarios, biodiversity, ecosystem services, nature’s contributions to people, nature futures, IPBES, visioning, narratives	1
Science-Policy	1
Stakeholder Survey	1
Transformative change	1
Transformative governance	1
VA	1
Values assessment	1
Zenodo	1

Licenses and Access

Licenses

#|

ipbes_zenodo |>
  sapply(
    FUN = function(x) {
      l <- x$metadata$license
      if (is.null(l)) {
        l <- "NULL"
      }
      return(l)
    }
  ) |>
  unlist() |>
  table(useNA = "always") |>
  knitr::kable(
    col.names = c(
      "license",
      "n"
    )
  )

license	n
cc-by-4.0	346
NULL	20
NA	0

Access Rights

#|

ipbes_zenodo |>
  sapply(
    FUN = function(x) {
      x$metadata$access_right
    }
  ) |>
  table(useNA = "always") |>
  knitr::kable(
    col.names = c(
      "access right",
      "n"
    )
  )

access right	n
embargoed	2
open	320
restricted	44
NA	0

IPBES Deposits Network

fn <- file.path("data", "ipbes_network.rds")

if (!file.exists(fn)) {
  relations <- lapply(
    ipbes_zenodo,
    function(rec) {
      relation <- rec$metadata$related_identifiers
      if (is.null(relation)) {
        return(NULL)
      }
      result <- rec$metadata$related_identifiers |>
        dplyr::bind_rows() |>
        dplyr::mutate(
          year = rec$metadata$publication_date,
          doi = rec$metadata$doi,
          title = rec$metadata$title,
          keywords = rec$metadata$keywords |>
            unlist() |>
            paste(collapse = "; "),
        )
      return(result)
    }
  ) |>
    dplyr::bind_rows() |>
    dplyr::left_join(
      y = read.table("inst/relation_direction.txt", header = TRUE),
      by = "relation"
    )

  nodes <- unique(
    c(
      relations$doi,
      relations$identifier
    )
  )

  edges <- rbind(
    relations |>
      filter(
        direction == "to"
      ) |>
      dplyr::select(
        from = doi,
        to = identifier
      ),
    relations |>
      filter(
        direction == "from"
      ) |>
      dplyr::select(
        from = doi,
        to = identifier
      )
  )

  network <- list(
    nodes = nodes,
    edges = edges
  )

  ipbes_network <- list(
    nodes = nodes,
    edges = edges,
    relations = relations
  )
  rm(nodes, edges, relations)

  saveRDS(ipbes_network, fn)
} else {
  ipbes_network <- readRDS(fn)
}

fn <- file.path("figures", "ipbes_network.html")

## Simple forceNetwork
networkData <- data.frame(
  src = ipbes_network$edges$from,
  target = ipbes_network$edges$to,
  stringsAsFactors = FALSE
)

nodes <- data.frame(
  name = ipbes_network$nodes,
  # title = ipbes_network$nodes$,
  # doi = ipbes_network$nodes$doi,
  stringsAsFactors = FALSE
)

nodes$id <- 0:(nrow(nodes) - 1)

# create a data frame of the edges that uses id 0:9 instead of their names
edges <- networkData |>
  left_join(nodes, by = c("src" = "name")) |>
  select(-src) |>
  rename(source = id) |>
  left_join(nodes, by = c("target" = "name")) |>
  select(-target) |>
  rename(target = id) |>
  mutate(width = 1)

# # make a grouping variable that will match to colours
nodes$group <- 1

# nodes$oa_id <- nodes$name
# nodes$name <- nodes$author

# control colours with a JS ordinal scale
# ColourScale <- 'd3.scaleOrdinal()
#                         .domain(["key_paper", "other"])
#                      .range(["#FF6900", "#694489"]);'

openDOI <- "window.open(d.doi)"

nwg <- networkD3::forceNetwork(
  Links = edges,
  Nodes = nodes,
  Source = "source",
  Target = "target",
  NodeID = "name",
  # Nodesize = "nodesize",
  Group = "group",
  # Value = "width",
  opacity = 0.9,
  zoom = TRUE,
  # colourScale = DT::JS(ColourScale),
  fontSize = 20,
  legend = TRUE,
  clickAction = openDOI
)

nwg$x$nodes$doi <- nodes$doi

networkD3::saveNetwork(
  nwg,
  file = fn,
  selfcontained = TRUE
)

unlink(
  gsub(
    fn,
    pattern = "\\.html",
    replacement = "_files"
  ),
  recursive = TRUE,
  force = TRUE
)


nwg

IPBES Deposits Network

ipbes_network$relations |>
  dplyr::select(
    year,
    doi,
    relation,
    identifier,
    direction,
    title,
    keywords
  ) |>
  IPBES.R::table_dt(
    fixedColumns = list(leftColumns = 6)
  )

IPBES deposits on Zenodo with OpenAlex ids

This is a quick and dirty table - it could made nicer - but it fulfills it’s purpose.

ipbes_works |>
  openalexR::works2df() |>
  dplyr::select(
    # year = publication_year,
    # title,
    doi,
    oa_id = id
  ) |>
  dplyr::mutate(
    doi = gsub(pattern = "https://doi.org/", replacement = "", x = doi)
  ) |>
  dplyr::left_join(
    x = dois,
    by = c("doi" = "doi")
  ) |>
  dplyr::mutate(
    doi = paste0("<a href='https://doi.org/", doi, "' target='_blank'>", doi, "</a>"),
    oa_id = ifelse(
      is.na(oa_id),
      "",
      paste0("<a href='", oa_id, "' target='_blank'>", gsub(pattern = "https://openalex.org/", replacement = "", oa_id), "</a>")
    )
  ) |>
  select(
    doi,
    oa_id,
    year,
    title
  ) |>
  IPBES.R::table_dt()